home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 58 / 058side2.d64 / bam organizer (.txt) < prev    next >
Commodore BASIC  |  2022-08-29  |  7KB  |  203 lines
  1. 100 h$=h$+"remove cartridgeabcdefghijk"
  2. 110 data162,4,32,198,255,160,,32,207,255,153
  3. 120 data229,159,200,192,27,208,245,32,204,255,96
  4. 130 fork=49152tok+21:reada:pokek,a
  5. 140 next
  6. 150 data unlock,lock,delete,move,working," rewrite bam",undelete,bar,rename
  7. 160 print"[147]"chr$(142)chr$(8):poke53281,0:po=53280:pokepo,0:gosub2010:fork=1to32
  8. 170 nl$=chr$(0):ef$=ef$+nl$:next:ps=1
  9. 180 fork=1to9:readpk$(k):next:dl$(0)="":dl$(1)="[157]d"
  10. 190 bo$(0)="":bo$(1)="[154]":lk$(0)=" ":lk$(1)="l":ch$(0)=" ":ch$(1)=">"
  11. 200 dimvt$(25),fl$(144),lk(144),d(144),ch(144),f(15),l(15):is=1
  12. 210 vt$(1)="":fork=1to24:vt$(k+1)=vt$(k)+"":next
  13. 220 l$="[213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201][194]"
  14. 230 l$=l$+"  [154]bam organizer  [194] [154]_[146] "
  15. 240 l$=l$+" for more options[194][171][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][195][195][195][195][179]"
  16. 250 l$=l$+"[194][154]page:  [194]"
  17. 260 m$(1)="[154]f-1[194][145][157][178][154]f-3[194][145][157][178][154]f-5[194][145][157][178][154]f-7[194][154] a[146]lphabetize  [194]"
  18. 270 m$(1)=m$(1)+"[171][195][195][195][195][178][195][195][177][195][195][195][219][195][195][195][177][195][195][178][177][195][195][195][177][195][195][195][178][195][195][195][195][178][195][195][195][195][195][179]"
  19. 280 m$(1)=m$(1)+"[194][154]l[146]ock[194][154]u[146]nlock"
  20. 290 m$(1)=m$(1)+"[194][154]d[146]el[195][154][157][145]ete[194][157][177][145][154]un[146]d[195][154][157][145]elete"
  21. 300 m$(1)=m$(1)+"[194][154]do[146]ne[194][154]ex[146]it![194]"
  22. 310 m$(1)=m$(1)+"[173][195][195][195][195][177][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][177][195][195][195][195][195][189]"
  23. 320 vn$="b[146]ar[194][145][157][219][157][177][145][154]r[146]e[145][195][157][195][145][157][154]name[194][145][157][178][157][177][145][154]m[146]ove"
  24. 330 m$(2)=left$(m$(1),117)+vn$+right$(m$(1),61)
  25. 340 n$="               [194][154]_[146]  cancel mode[194][171][195][195][195][195][195][195][195][177][178][195][195][195][195][195][195][195][195][195][195][195][195][195][195]"
  26. 350 n$=n$+"[219][195][195][195][195][195][195][195][178][195][195][195][195][195][195][179][194][154]t[146] toggle[194][154] a[146] toggle all [194][154] b[146] bar [194]"
  27. 360 n$=n$+"[154]d[146]o it![194][173][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][177][195][195][195][195][195][195][189]"
  28. 370 fork=1to11:c1$=c1$+nl$:next
  29. 380 da$="[195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195]"+c1$+chr$(131)+chr$(18)+chr$(1)
  30. 390 g$="               ":goto430
  31. 400 ift=0thenclose4:cl=1:return
  32. 410 print#15,"u1:";4;0;t;s:gosub1630:get#4,t$,s$
  33. 420 gosub1630:t=asc(t$+nl$):s=asc(s$+nl$):return
  34. 430 printl$m$(1):printvt$(15)"[145][145][145][145] insert disk to be organized in drive 8"
  35. 440 print"      and press <space> when ready"
  36. 450 geta$:ifa$<>" "then450
  37. 460 print"         now loading directory":nl$=nl$:t=18:s=0
  38. 470 open15,8,15:open4,8,4,"#":gosub400:gosub400
  39. 480 bf=bf+1:ifbf=9thengosub400:bf=1:ifclthenpokepo,0:goto550
  40. 490 print#15,"b-p:";4;32*(bf-1)+2:gosub1630
  41. 500 get#4,a$,c$,d$:gosub1630:ifa$=""andc$=""andd$=""then480
  42. 510 p1=p1+1+255*(p1=255):pokepo,p1:ifd$=""thend$=nl$
  43. 520 fl=fl+1:ifasc(a$+nl$)>191thenlk(fl)=1
  44. 530 ifa$=""thena$=nl$:d(fl)=1
  45. 540 sys49152:gosub1630:fl$(fl)=h$+a$+c$+d$:goto480
  46. 550 p=0:mp%=(fl-1)/36:gosub560:goto630
  47. 560 fork=24to7step-1:poke781,k:sys59903:next:fork=0to1
  48. 570 printvt$(4)"[154]"p+1vt$(8);:forj=1to18
  49. 580 fi=p*36+k*18+j:ifkthenprintspc(19)"[194]";
  50. 590 printlk$(lk(fi))dl$(d(fi))ch$(ch(fi))""left$(fl$(fi),16);
  51. 600 ifj=18thenprint"[145]":goto620
  52. 610 print
  53. 620 next:next:return
  54. 630 gosub1880:pk=-(a$="u")-2*(a$="l")-3*(a$="d")-4*(a$="m")-5*(a$="a")
  55. 640 pk=pk-6*(a$="o")-7*(a$="n")-8*(a$="b")-9*(a$="r")
  56. 650 ifpkthen750
  57. 660 ifa$="x"thenprint"[147]":close15:goto1900
  58. 670 ifa$="_"thenis=3-is:printl$m$(is):goto630
  59. 680 gosub690:goto630
  60. 690 ifa$<>"[133]"thenifa$<>"[134]"thenifa$<>"[135]"thenifa$<>"[136]"thenreturn
  61. 700 q=p:p=0*(a$="[133]")-(a$="[134]")-2*(a$="[135]")-3*(a$="[136]")
  62. 710 ifp=qthenbo=0:gosub810:tu=1:return
  63. 720 ifp>mp%thenp=q:goto740
  64. 730 ifp<>qthentu=1:gosub560
  65. 740 return:goto630
  66. 750 printl$n$;:gosub760:goto770
  67. 760 printvt$(4)"[154]"p+1g$vt$(4)spc(16-len(pk$(pk))/2)"[154]"pk$(pk):return
  68. 770 ifpk=5then1310
  69. 780 ifpk=6then1450
  70. 790 ps=1:lr=0:bo=1
  71. 800 gosub810:goto840
  72. 810 printvt$(7+ps);:iflrthenprintspc(20);
  73. 820 fi=p*36+lr*18+ps:printlk$(lk(fi))dl$(d(fi))ch$(ch(fi))bo$(bo);
  74. 830 printleft$(fl$(fi),16)"[146]";:return
  75. 840 poke198,0:gosub1880
  76. 850 ifa$<>"[145]"then900
  77. 860 ifp=0theniflr=0thenifps=1then840
  78. 870 bo=0:gosub810:ps=ps-1
  79. 880 ifps=0thenps=18:pp=p+(lr=0):lr=2-(lr+1):ifpp<pthenp=pp:gosub560
  80. 890 bo=1:gosub810:goto840
  81. 900 ifa$<>""then950
  82. 910 ifp*36+lr*18+ps+1>flthen840
  83. 920 bo=0:gosub810:ps=ps+1
  84. 930 ifps=19thenps=1:pp=p-(lr=1):lr=2-(lr+1):ifpp>pthenp=pp:gosub560
  85. 940 bo=1:gosub810:goto840
  86. 950 ifa$<>""anda$<>"[157]"then980
  87. 960 ifp*36+(2-(lr+1))*18+ps>flthen840
  88. 970 bo=0:gosub810:lr=2-(lr+1):bo=1:gosub810:goto840
  89. 980 ifa$="_"thenfork=1tofl:ch(k)=0:next:printl$m$(is):goto550
  90. 990 ifa$="b"andpk=8then1720
  91. 1000 ifa$<>"t"then1150
  92. 1010 ifpk=9thenr$="":goto1760
  93. 1020 ifpk<>4then1070
  94. 1030 ifmv=0thenmv=fi:goto1070
  95. 1040 ifmv=fithenmv=0:goto1070
  96. 1050 goto1080
  97. 1060 mv=0:gosub560:goto800
  98. 1070 ch(fi)=2-(ch(fi)+1):gosub810:goto840
  99. 1080 iffi=mvthenmv=0:goto1070
  100. 1090 z=pk:pk=5:gosub760:ch(mv)=0:t1=d(mv):t=lk(mv):t$=fl$(mv)
  101. 1100 ifmv<fithen1130
  102. 1110 fork=mvtofi+1step-1:lk(k)=lk(k-1):fl$(k)=fl$(k-1):d(k)=d(k-1)
  103. 1120 next:goto1140
  104. 1130 fork=mvtofi-2:lk(k)=lk(k+1):fl$(k)=fl$(k+1):d(k)=d(k+1):next
  105. 1140 d(k)=t1:lk(k)=t:fl$(k)=t$:mv=0:pk=z:gosub760:goto1060
  106. 1150 ifnot(a$="a"andpk<4)then1170
  107. 1160 forq=1tofl:ch(q)=2-(ch(q)+1):next:gosub560:gosub810:goto840
  108. 1170 ifa$<>"d"orpk=4then1290
  109. 1180 z=pk:pk=5:gosub760:pk=z:fork=flto1step-1:d=d(k):l=lk(k)
  110. 1190 ifch(k)=0then1280
  111. 1200 ifpk=7anddthendl=130:gosub1740
  112. 1210 ifpk=3andl=0andd=0thendl=0:gosub1740
  113. 1220 if(pk=1andl)or(pk=2andl=0)then1240
  114. 1230 goto1280
  115. 1240 ifd(k)then1280
  116. 1250 lk(k)=-(pk=2):e$=fl$(k):e1=asc(mid$(e$,28,1))
  117. 1260 fl$(k)=left$(e$,27)+chr$(e1-64*(e1<133)+64*(e1>191))
  118. 1270 fl$(k)=fl$(k)+right$(e$,2)
  119. 1280 next:a$="_":goto980
  120. 1290 gosub690:iftuthenps=1:lr=0:bo=1:tu=0:gosub810:goto840
  121. 1300 goto840
  122. 1310 t=0:s=1:bf=fl
  123. 1320 a$=fl$(int((bf+s)/2)):k=s:j=bf
  124. 1330 iffl$(k)<a$thenk=k+1:goto1330
  125. 1340 iffl$(j)>a$thenj=j-1:goto1340
  126. 1350 ifk>jthen1400
  127. 1360 ifk=jthen1390
  128. 1370 t$=fl$(k):fl$(k)=fl$(j):fl$(j)=t$:p=lk(k):lk(k)=lk(j):lk(j)=p
  129. 1380 t1=d(k):d(k)=d(j):d(j)=t1
  130. 1390 k=k+1:j=j-1:ifk<=jthen1330
  131. 1400 ifk>=bfthen1420
  132. 1410 f(t)=k:l(t)=bf:t=t+1
  133. 1420 bf=j:ifs<bfthen1320
  134. 1430 ift=0then1860
  135. 1440 t=t-1:s=f(t):bf=l(t):goto1320
  136. 1450 gosub1710:printspc(11)"[145][145]are you sure (y/n)?"
  137. 1460 gosub1880
  138. 1470 ifa$<>"y"anda$<>"n"then1460
  139. 1480 ifa$="n"thenprintl$m$(is):goto550
  140. 1490 gosub1710:printspc(12)"[145][145]now rewriting bam":pk=5
  141. 1500 gosub760:t=18:s=0:open4,8,4,"#":gosub400
  142. 1510 print#15,"b-p:";4;2
  143. 1520 ct=ct+1:ifct<145then1550
  144. 1530 gosub1710:printspc(11)"[145][145]now validating disk":print#15,"v"
  145. 1540 gosub1630:close4:close15:goto1900
  146. 1550 ifefthenprint#4,ef$;:goto1570
  147. 1560 print#4,right$(fl$(ct),3)left$(fl$(ct),27)"cd";
  148. 1570 ifct=flthenef=1
  149. 1580 p1=p1+1+255*(p1=255):pokepo,p1:ifct/8<>int(ct/8)then1520
  150. 1590 ls=s+3+17*(s>15):t=18:print#15,"b-p:";4,0
  151. 1600 ifefthenprint#4,nl$chr$(255);:gosub1630:goto1620
  152. 1610 print#4,chr$(t)chr$(ls);:gosub1630
  153. 1620 print#15,"u2:";4;0;18;s:gosub1630:s=ls:goto1520
  154. 1630 input#15,ds,ds$,tn,sn:ifds=.thenreturn
  155. 1640 ifds<>26then1690
  156. 1650 printvt$(11)spc(10)"remove w/protect tab!"
  157. 1660 printspc(10)"         &         ":printspc(13)"press <return>"
  158. 1670 geta$:ifa$<>chr$(13)then1670
  159. 1680 ct=0:close4:goto1490
  160. 1690 print"[147]drive error...program aborted":print""ds;ds$tn;sn
  161. 1700 close4:clos